home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / lib / tex / uuencode.shar / uuencode.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-04-18  |  4.6 KB  |  195 lines
  1. Program uuencode;
  2.  
  3.   CONST header = 'begin';
  4.         trailer = 'end';
  5.         defaultMode = '644';
  6.         defaultExtension = '.uue';
  7.         offset = 32;
  8.         charsPerLine = 60;
  9.         bytesPerHunk = 3;
  10.         sixBitMask = $3F;
  11.  
  12.   TYPE string80 = string[80];
  13.  
  14.   VAR infile: file of byte;
  15.       outfile: text;
  16.       infilename, outfilename, mode: string80;
  17.       lineLength, numbytes, bytesInLine: integer;
  18.       line: array [0..59] of char;
  19.       hunk: array [0..2] of byte;
  20.       chars: array [0..3] of byte;
  21.  
  22. {  procedure debug;
  23.  
  24.     var i: integer;
  25.  
  26.     procedure writebin(x: byte);
  27.  
  28.       var i: integer;
  29.  
  30.       begin
  31.         for i := 1 to 8 do
  32.           begin
  33.             write ((x and $80) shr 7);
  34.             x := x shl 1
  35.           end;
  36.         write (' ')
  37.       end;
  38.  
  39.     begin
  40.       for i := 0 to 2 do writebin(hunk[i]);
  41.       writeln;
  42.       for i := 0 to 3 do writebin(chars[i]);
  43.       writeln;
  44.       for i := 0 to 3 do writebin(chars[i] and sixBitMask);
  45.       writeln
  46.     end;  }
  47.  
  48.   procedure Abort (message: string80);
  49.  
  50.     begin {abort}
  51.       writeln(message);
  52.       close(infile);
  53.       close(outfile);
  54.       halt
  55.     end; {abort}
  56.  
  57.   procedure Init;
  58.  
  59.     procedure GetFiles;
  60.  
  61.       VAR i: integer;
  62.           temp: string80;
  63.           ch: char;
  64.  
  65.       begin {GetFiles}
  66.         if ParamCount < 1 then abort ('No input file specified.');
  67.         infilename := ParamStr(1);
  68.         {$I-}
  69.         assign (infile, infilename);
  70.         reset (infile);
  71.         {$i+}
  72.         if IOResult > 0 then abort (concat ('Can''t open file ', infilename));
  73.         write('Uuencoding file ', infilename);
  74.  
  75.         i := pos('.', infilename);
  76.         if i = 0
  77.           then outfilename := infilename
  78.           else outfilename := copy (infilename, 1, pred(i));
  79.         mode := defaultMode;
  80.         if ParamCount > 1 then
  81.           for i := 2 to ParamCount do
  82.             begin
  83.               temp := Paramstr(i);
  84.               if temp[1] in ['0'..'9']
  85.                 then mode := temp
  86.                 else outfilename := temp
  87.             end;
  88.         if pos ('.', outfilename) = 0
  89.           then outfilename := concat(outfilename, defaultExtension);
  90.         assign (outfile, outfilename);
  91.         writeln (' to file ', outfilename, '.');
  92.  
  93.         {$i-}
  94.         reset(outfile);
  95.         {$i+}
  96.         if IOresult = 0 then
  97.           begin
  98.             Write ('Overwrite current ', outfilename, '? [Y/N] ');
  99.             repeat
  100.               read (kbd, ch);
  101.               ch := Upcase(ch)
  102.             until ch in ['Y', 'N'];
  103.             writeln (ch);
  104.             if ch = 'N' then abort(concat (outfilename, ' not overwritten.'))
  105.           end;
  106.         close(outfile);
  107.  
  108.         {$i-}
  109.         rewrite(outfile);
  110.         {$i+}
  111.         if ioresult > 0 then abort(concat('Can''t open ', outfilename));
  112.       end; {getfiles}
  113.  
  114.     begin {Init}
  115.       GetFiles;
  116.       bytesInLine := 0;
  117.       lineLength := 0;
  118.       numbytes := 0;
  119.       writeln (outfile, header, ' ', mode, ' ', infilename);
  120.     end; {init}
  121.  
  122.   procedure FlushLine;
  123.  
  124.     VAR i: integer;
  125.  
  126.     procedure writeout(ch: char);
  127.  
  128.       begin {writeout}
  129.         if ch = ' ' then write(outfile, '`')
  130.                     else write(outfile, ch)
  131.       end; {writeout}
  132.  
  133.     begin {FlushLine}
  134.       write ('.');
  135.       writeout(chr(bytesInLine + offset));
  136.       for i := 0 to pred(lineLength) do
  137.         writeout(line[i]);
  138.       writeln (outfile);
  139.       lineLength := 0;
  140.       bytesInLine := 0
  141.     end; {FlushLine}
  142.  
  143.   procedure FlushHunk;
  144.  
  145.     VAR i: integer;
  146.  
  147.     begin {FlushHunk}
  148.       if lineLength = charsPerLine then FlushLine;
  149.       chars[0] := hunk[0] shr 2;
  150.       chars[1] := (hunk[0] shl 4) + (hunk[1] shr 4);
  151.       chars[2] := (hunk[1] shl 2) + (hunk[2] shr 6);
  152.       chars[3] := hunk[2] and sixBitMask;
  153.       {debug;}
  154.       for i := 0 to 3 do
  155.         begin
  156.           line[lineLength] := chr((chars[i] and sixBitMask) + offset);
  157.           {write(line[linelength]:2);}
  158.           lineLength := succ(lineLength)
  159.         end;
  160.       {writeln;}
  161.       bytesInLine := bytesInLine + numbytes;
  162.       numbytes := 0
  163.     end; {FlushHunk}
  164.  
  165.   procedure encode1;
  166.  
  167.     begin {encode1};
  168.       if numbytes = bytesperhunk then flushhunk;
  169.       read (infile, hunk[numbytes]);
  170.       numbytes := succ(numbytes)
  171.     end; {encode1}
  172.  
  173.   procedure terminate;
  174.  
  175.     begin {terminate}
  176.       if numbytes > 0 then flushhunk;
  177.       if lineLength > 0
  178.         then
  179.           begin
  180.             flushLine;
  181.             flushLine;
  182.           end
  183.         else flushline;
  184.       writeln (outfile, trailer);
  185.       close (outfile);
  186.       close (infile);
  187.     end; {terminate}
  188.  
  189.  
  190.   begin {uuencode}
  191.     init;
  192.     while not eof (infile) do encode1;
  193.     terminate
  194.   end. {uuencode}
  195.